library(rnrfa)
setwd("~/Documents/Coding/GISWORK")
library(readr)
ListOfWainrights <- read_csv("ListOfWainrights.csv")
## Rows: 214 Columns: 1
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Wainrights
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
library(tidyr)
df_new <- separate(ListOfWainrights, Wainrights, into = c("Drop", "Keep"), sep = "^\\S*\\K\\s+")
df_new <- df_new[,2]
df_new <- separate(df_new, Keep, into = c("OSGRidRef", "Wainright"), sep = "^\\S*\\K\\s+")
WainrightsInfo <- separate(df_new, Wainright, into = c('Name', 'Height'), sep = '\\(.*')
library(stringr)
ElevationMeters <- as.numeric(sub("\\D*(\\d{3}).*", "\\1", df_new$Wainright))
WainrightsInfo$Height <- ElevationMeters
Coordinates <- osg_parse(WainrightsInfo$OSGRidRef, coord_system = "WGS84")
## Warning in showSRID(uprojargs, format = "PROJ", multiline = "NO", prefer_proj
## = prefer_proj): Discarded datum Ordnance_Survey_of_Great_Britain_1936 in Proj4
## definition
WainrightsInfo$lon <- Coordinates[[1]]
WainrightsInfo$lat <- Coordinates[[2]]
library(maps)
library(ggplot2)
worldmap = map_data('world')
ggplot() +
geom_polygon(data = worldmap,
aes(x = long, y = lat, group = group),
fill = 'gray90', color = 'black') +
coord_fixed(ratio = 1.3, xlim = c(-10,3), ylim = c(50, 59)) +
theme_void() +
geom_point(data = WainrightsInfo,
aes(x = as.numeric(lon),
y = as.numeric(lat)), color = 'black', alpha = .7) +
scale_size_area(max_size = 8) +
scale_color_viridis_c() +
theme(legend.position = 'none') +
theme(title = element_text(size = 12))
library(ggmap)
## Google's Terms of Service: https://cloud.google.com/maps-platform/terms/.
## Please cite ggmap if you use it! See citation("ggmap") for details.
#register_google(key = "AIzaSyCvfTWzbATsQ4uJDSrygv0k-1DqqbFm8qA", write = TRUE)
#LakeDistrictBox <- make_bbox(lon = WainrightsInfo$longitude, lat = WainrightsInfo$latitude, f = #.1)
LakeDistrictBox <- c(left = min(WainrightsInfo$lon)-0.1, bottom = min(WainrightsInfo$lat)-0.05,
right = max(WainrightsInfo$lon)+0.1, top = max(WainrightsInfo$lat)+0.05)
sq_map <- get_stamenmap( LakeDistrictBox, maptype = "terrain")
## Source : http://tile.stamen.com/terrain/10/501/325.png
## Source : http://tile.stamen.com/terrain/10/502/325.png
## Source : http://tile.stamen.com/terrain/10/503/325.png
## Source : http://tile.stamen.com/terrain/10/504/325.png
## Source : http://tile.stamen.com/terrain/10/501/326.png
## Source : http://tile.stamen.com/terrain/10/502/326.png
## Source : http://tile.stamen.com/terrain/10/503/326.png
## Source : http://tile.stamen.com/terrain/10/504/326.png
## Source : http://tile.stamen.com/terrain/10/501/327.png
## Source : http://tile.stamen.com/terrain/10/502/327.png
## Source : http://tile.stamen.com/terrain/10/503/327.png
## Source : http://tile.stamen.com/terrain/10/504/327.png
og_map <- ggmap(sq_map) + geom_point(data = WainrightsInfo, color = "red", size = 1)
plot(og_map)
signalling for wainrights I have summitted.
WainrightsInfo$Name <- trimws(WainrightsInfo$Name, which = c("both"))
WainrightsInfo$Summitted <- 0
for (name in 1:length(WainrightsInfo$Name)){
if (WainrightsInfo$Name[name] %in% c('Helvellyn', 'Mardale Ill Bell', 'High Street', 'The Knott (High Street)', 'Rampsgill Head', 'Kidsty Pike', 'Holme Fell', 'Tarn Crag', 'Loughrigg Fell', 'Hallin Fell')){
WainrightsInfo$Summitted[name] <- 1
}
}
WainrightsInfo$Summitted <- as.factor(WainrightsInfo$Summitted)
sq_map <- get_map(location = LakeDistrictBox, maptype = "satellite", source = "google")
ggmap(sq_map) + geom_point(data = WainrightsInfo, aes(color = Summitted), size = 1) + scale_colour_manual(values = c('red', 'green'))
Removing the wainrights which I have already summitted
SummittedPeaks <- WainrightsInfo[which(WainrightsInfo$Summitted == 0),]
#Clustering problem
library(ClusterR)
## Loading required package: gtools
library(cluster)
##
## Attaching package: 'cluster'
## The following object is masked from 'package:maps':
##
## votes.repub
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
WainRightCoords <- SummittedPeaks[,c('lon', 'lat')]
set.seed(314) # Setting seed
elbowPlot <- fviz_nbclust(WainRightCoords, kmeans, method = "wss", k.max = 25)
plot(elbowPlot)
24 clusters looks good
finalClustering <- kmeans(WainRightCoords, 24, nstart = 25)
SummittedPeaks$Cluster <- as.factor(finalClustering$cluster)
ggmap(sq_map) + geom_point(data = SummittedPeaks, aes(color = Cluster), size = 3)
#+ scale_colour_manual(values = c('red', 'green'))
library(TSP)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(leaflet)
dist_mat <-
dist(
SummittedPeaks %>% dplyr::select(lon, lat),
method = 'euclidean'
)
tsp_prob <- TSP(dist_mat)
tsp_prob <- insert_dummy(tsp_prob, label = 'dummy')
tour <-
solve_TSP(
tsp_prob,
method = 'two_opt',
control = list(rep = 16)
)
## Warning: executing %dopar% sequentially: no parallel backend registered
path <- names(cut_tour(tour, 'dummy'))
SummittedPeaks <-SummittedPeaks %>%
mutate(id_order = order(as.integer(path)))
SummittedPeaks %>%
arrange(id_order) %>%
leaflet() %>%
addTiles() %>%
addCircleMarkers(
~lon,
~lat,
fillColor = 'red',
fillOpacity = 0.5,
stroke = FALSE
) %>%
addPolylines(~lon, ~lat)
h <- ggplot(data=SummittedPeaks, aes(lon,lat, color = Cluster))
h <- h + geom_point()
h +
geom_path(data=SummittedPeaks,aes(color = Cluster))
FinalMap <- ggmap(sq_map) + geom_point(data=SummittedPeaks, aes(lon,lat, color = Cluster)) +
geom_path(data=SummittedPeaks,aes(color = Cluster, group = Cluster), color = 'black')
FinalMap + theme(legend.position="none") + ggtitle('Lake Distrt Wainright clustering')